(* ===================================================================== *)
(** Application bop2c : traduction d'une net-list .bop vers une net-list
    à plat en C standard (à compiler ensuite en -O3 par exemple, pour aller
    vers de la performance de simulation.)
    @author Mathieu Barbin
    @version 1.0.* *)
(* ===================================================================== *)


(** On travaille à partir du circuit cds final (juste avant l'instanciation 
   du circuit, de sorte de pouvoir traduire des circuits bpx) 

   Le but est ici de generer un code c simulant nativement un circuit 
   que l'on donne sous la meme forme que les arguments recus par le 
   constructeur de la classe circuit, ie, un cds trié topologiquement
   et les memoires.
*)
open Circuit 

(* <h2> Gestion d'une map indexee par un couple d'entier </h2>*)

module IntIntOrder : (Set.OrderedType with type t = int * int) =
struct
  type t = int * int
  let compare ((a:int),(b:int)) (a', b') = 
    let r = Pervasives.compare a a' in
    if r <> 0 then r else Pervasives.compare b b'
end

module IntIntMap = Map.Make (IntIntOrder)

(* ===================================================================== *)
(** Quelques conventions dans la net list produite *)
(* ===================================================================== *)
module Ccode =
struct
  let taille_input = 256
  let input_name = "input_string"
  let output_name = "output_string"

  let output_decl n = 
    let val_init =
      let rec aux accu i =
	if i = n
	then accu^"'\\0'}"
	else aux (Printf.sprintf "%s'0'," accu) (succ i)
      in aux "{" 0
    in Printf.sprintf "unsigned char %s[%d] = %s;" output_name (succ n) val_init

  let input_decl i = Printf.sprintf "unsigned char %s[%d];" input_name i
  let of_id s a  = Printf.sprintf "%s=%s;" s a
  let of_not s a  = Printf.sprintf "%s=!%s;" s a  
  let of_and s a b = Printf.sprintf "%s=%s&&%s;" s a b
  let of_or s a b = Printf.sprintf "%s=%s||%s;" s a b
  let of_xor s a b = Printf.sprintf "%s = (%s) ? (!%s) : (%s);" s a b b
  let of_mux s e a b = Printf.sprintf "%s = (%s) ? %s : %s;" s e a b
    
  let input n =
    let entete = 
      let rec aux accu i = 
	if i >= n
	then accu^")"
	else
	  if (i = pred n) 
	  then (Printf.sprintf "%s unsigned char *e%d)" accu i)
	  else aux (Printf.sprintf "%s unsigned char *e%d," accu i) (succ i)
      in aux "(" 0 
    in
    let corps =
      let rec aux accu i =
	if i >= n
	then accu
	else
	  if (i = pred n)
	  then (Printf.sprintf "%s *e%d=(%s[%d]=='1');" accu i input_name i)
	  else aux (Printf.sprintf "%s *e%d=(%s[%d]=='1');\n" accu i input_name i) (succ i)
      in aux "" 0
    in
    Printf.sprintf "void input%s{\n pipe01(%s, %d, stdin);\n%s\n}"
      entete input_name n corps

  let output n =
    let entete =
      let rec aux accu i = 
	if i >= n
	then accu^")"
	else
	  if (i = pred n) 
	  then (Printf.sprintf "%s unsigned char e%d)" accu i)
	  else aux (Printf.sprintf "%s unsigned char e%d," accu i) (succ i)
      in aux "(" 0 
    in
    let corps =
      let rec aux accu i =
	if i >= n
	then accu
	else
	  if (i = pred n)
	  then (Printf.sprintf "%s %s[%d] = e%d ? '1' : '0';" accu output_name i i)
	  else aux (Printf.sprintf "%s %s[%d] = e%d ? '1' : '0';\n" accu output_name i i) (succ i)
      in aux "" 0
    in
    Printf.sprintf "void output%s{\n%s\n fprintf(stdout, \"%cs\\n\", %s);\n fflush(stdout);\n}"
      entete corps '%' output_name

  let call_mono name typ args =
    let n = Array.length args in
    let rec aux accu i = 
      if i >= n
      then accu^");"
      else
	if i = pred n 
	then (Printf.sprintf "%s %s%s);" accu typ args.(i))
	else aux (Printf.sprintf "%s %s%s," accu typ args.(i)) (succ i)
    in aux (Printf.sprintf "%s(" name) 0

  let call_poly name typs args =
    let n = Array.length args in
    let rec aux accu i = 
      if i = pred n 
      then (Printf.sprintf "%s %s%s);" accu typs.(i) args.(i))
      else aux (Printf.sprintf "%s %s%s," accu typs.(i) args.(i)) (succ i)
    in aux (Printf.sprintf "%s(" name) 0

  (* code C d'initialisation de tableaux en dur *)

  let init_tab1 t = 
    let len = Array.length t in
    let rec aux accu i =
      if i >= pred len
      then accu^(if t.(i) then "1}" else "0}")
      else aux (accu^(if t.(i) then "1, " else "0, ")) (succ i)
    in aux "{" 0

  let init_tab2 t =
    let len = Array.length t in
    let rec aux accu i =
      if i >= pred len
      then accu^(init_tab1 t.(i))^"}"
      else aux (accu^(init_tab1 t.(i))^", ") (succ i)
    in aux "{" 0

  (** calculer l'index en fonction d'un certain nombre de bits en petit indien *)
  let index_of_bits index t =
    let len = Array.length t in
    if len = 0 
    then (Printf.sprintf "%s = 0;" index) 
    else
      let rec aux accu puissance i =
	if i >= len
	then accu^";"
	else aux (Printf.sprintf "%s + %d * %s" accu puissance t.(i)) (2*puissance) (succ i)
      in aux (Printf.sprintf "%s = %s" index t.(0)) 2 1

  let assign_bits_of_tab tab ind1 ln cible_pref =
    let out = ref "" in
    for i = 0 to pred ln do
      out := (Printf.sprintf "%s%s%d = %s[%s][%d];" (!out) cible_pref i tab ind1 i)
    done;
    !out

  let assign_tab_of_bits tab ind1 ln cible_pref =
    let out = ref "" in
    for i = 0 to pred ln do
      out := (Printf.sprintf "%s%s[%s][%d] = %s%d;" (!out) tab ind1 i cible_pref i)
    done;
    !out

  (** code c des fonctions d'acces memoires *)
  let function_ram id nb_case len_case = 
    let bits = int_of_float (log (float_of_int nb_case) /. log 2.) in
    let entrees = 2 * bits + 1 + len_case in
    let tab_read_add = Array.init bits (fun i -> Printf.sprintf "r%d" i) in
    let tab_write_add = Array.init bits (fun i -> Printf.sprintf "e%d" i) in
    let tab_data = Array.init len_case (fun i -> Printf.sprintf "d%d" i) in
    let tab_sorties = Array.init len_case (fun i -> Printf.sprintf "s%d" i) in
    let typs = let f_init i = if i < entrees then "unsigned char " else "unsigned char *" 
    in Array.init (entrees+len_case) f_init
    and tabs = Array.concat [tab_read_add;tab_write_add;[|"en"|];tab_data;tab_sorties] in
    let pp = (call_poly (Printf.sprintf "void callram%d" id) typs tabs) in
    let corps =
      begin
	Printf.sprintf "int index;\nif(en){\n%s%s\n}else{\n%s%s}" 
	  (index_of_bits "index" tab_write_add) 
	  (assign_tab_of_bits (Printf.sprintf "ram%d" id) "index" len_case "d")
	  (index_of_bits "index" tab_read_add) 
	  (assign_bits_of_tab (Printf.sprintf "ram%d" id) "index" len_case "*s")
      end
    in
    Printf.sprintf "%s\n{\n%s\n}" (String.sub pp 0 (pred (String.length pp))) corps
    
  let function_rom id nb_case len_case = 
    let bits = int_of_float (log (float_of_int nb_case) /. log 2.) in
    let tab_entrees = Array.init bits (fun i -> Printf.sprintf "e%d" i) in
    let tab_sorties = Array.init len_case (fun i -> Printf.sprintf "s%d" i) in
    let typs = let f_init i = if i < bits then "unsigned char " else "unsigned char *" 
    in Array.init (bits+len_case) f_init
    and tabs = Array.concat [tab_entrees;tab_sorties] in
    let pp = (call_poly (Printf.sprintf "void callrom%d" id) typs tabs) in
    let corps =
      begin
	Printf.sprintf "int index;\n%s\n%s" (index_of_bits "index" tab_entrees)
	  (assign_bits_of_tab (Printf.sprintf "rom%d" id) "index" len_case "*s")
      end
    in
    Printf.sprintf "%s\n{\n%s\n}" (String.sub pp 0 (pred (String.length pp))) corps
    
  (** of_ram gere la declaration et la fonction *)
  let of_ram id ram_state = 
    let nb_case = Array.length ram_state in
    let len_case = Array.length ram_state.(0) in
    let decl = Printf.sprintf "unsigned char %s%d[%d][%d] = %s;" 
      "ram" id nb_case len_case (init_tab2 ram_state) in 
    let code = function_ram id nb_case len_case in
    Printf.sprintf "\n%s\n%s\n" decl code
      
  (** of_rom de meme *)
  let of_rom id rom_state = 
    let nb_case = Array.length rom_state in
    let len_case = Array.length rom_state.(0) in
    let decl = Printf.sprintf "unsigned char %s%d[%d][%d] = %s;" 
      "rom" id nb_case len_case (init_tab2 rom_state) in 
    let code = function_rom id nb_case len_case in
    Printf.sprintf "\n%s\n%s\n" decl code
      
end;;
(* ===================================================================== *)

(** <h2> Production du code C </h2> *)

(* ===================================================================== *)
(** On entre dans le vif du sujet : etant donne un cds trie topologiquement
    et avec splité au niveau des registres, on produit le code en C. *)
(* ===================================================================== *)
let produce_code_of_cds_final cds =
  let fresh_ram, _ = fresh_fct_factory (fun i -> i) in
  let n = Array.length cds in
  let q_vars = Queue.create () in
  let q_decl_init = Queue.create () in
  let q_assign_init = Queue.create () in
  let q_node = Queue.create () in
  let q_ram = Queue.create () in
  let q_reg = Queue.create () in
  let iimap = ref IntIntMap.empty in
  let produce_code s = Queue.add s q_node in
  let rec aux i =
    if i = n 
    then (q_vars, q_decl_init, q_assign_init, q_node, q_ram, q_reg, !iimap)
    else
      let ne = Array.length cds.(i).entree in
      let ns = Array.length cds.(i).sortie in
      let tab_entree =
	let f_init k =
	  try
	    IntIntMap.find (i, k) (!iimap)
	  with
	  | Not_found -> 
	      Printf.fprintf stderr "Entree non assignee (%d,%d) : Constante = %c\n" i k (if cds.(i).entree.(k) then '1' else '0'); 
	      flush stderr;
	      if cds.(i).entree.(k)
	      then "1"
	      else "0"
	in
	Array.init ne f_init
      in
      let tab_sortie =
	let f_init k = 
	  let s = Printf.sprintf "s_%d_%d" i k in
	  Queue.add s q_vars; s
	in Array.init ns f_init
      in
      begin
	(* ajout des liens vers variables pour les voisins *)
	for k = 0 to pred ns do
	  let sname = tab_sortie.(k) in
	  let f_iter (a,b) =
	    if IntIntMap.mem (a, b) (!iimap)
	    then failwith "Entree conflictuelle"
	    else iimap := IntIntMap.add (a,b) sname (!iimap)
	  in List.iter f_iter cds.(i).voisins.(k)
	done;
	(* maintenant, on entre dans le vif du sujet : traitement des appels *)
	(
	match cds.(i).noeud_type with
	| Input -> 
	    begin
	      Printf.fprintf stderr "Input Count : %d\n" ns; flush stderr;
	      Queue.add (Ccode.input_decl ns) q_decl_init;
	      Queue.add (Ccode.input ns) q_decl_init; 
	      produce_code (Ccode.call_mono "input" "&" tab_sortie)
	    end
	| Output -> 
	    begin
	      Printf.fprintf stderr "Output Count : %d\n" ne; flush stderr;
	      Queue.add (Ccode.output_decl ne) q_decl_init;
	      Queue.add (Ccode.output ne) q_decl_init;
	      produce_code (Ccode.call_mono "output" "" tab_entree) 
	    end
	| Id -> produce_code (Ccode.of_id tab_sortie.(0) tab_entree.(0))
	| Not -> produce_code (Ccode.of_not tab_sortie.(0) tab_entree.(0)) 
	| Et -> produce_code (Ccode.of_and tab_sortie.(0) tab_entree.(0) tab_entree.(1))  
	| Ou -> produce_code (Ccode.of_or tab_sortie.(0) tab_entree.(0) tab_entree.(1)) 
	| Xor-> produce_code (Ccode.of_xor tab_sortie.(0) tab_entree.(0) tab_entree.(1))  
	| Mux -> produce_code (Ccode.of_mux tab_sortie.(0) tab_entree.(0) tab_entree.(1) tab_entree.(2))   
	| Rom (_, n) -> 
	    begin
	      (* on a déjà crée une bonne primitive qui s'appelle callrom%d *)
	      (* les arguments d'adresse sont unsigned char, les autres pointeurs *)
	      let typs = let f_init i = if i < ne then "" else "&" in Array.init (ne+ns) f_init
	      and tabs = Array.concat [tab_entree;tab_sortie] in
	      produce_code (Ccode.call_poly (Printf.sprintf "callrom%d" n) typs tabs) 
	    end
	| Ram (_, (ar_e, ar_s, etat_courant))  ->
	    let num_ram = fresh_ram () in
	    begin
	      (* c'est comme pour les rom, sauf qu'on doit gérer ici la declaration *)
	      Queue.add (Ccode.of_ram num_ram etat_courant) q_ram;
	      (* et ensuite faire l'appel correct *)
	      let typs = let f_init i = if i < ne then "" else "&" in Array.init (ne+ns) f_init
	      and tabs = Array.concat [tab_entree;tab_sortie] in
	      produce_code (Ccode.call_poly (Printf.sprintf "callram%d" num_ram) typs tabs)
	    end
	| Clock -> produce_code (Printf.sprintf "%s=1;" tab_sortie.(0))
	| Gnd -> produce_code (Printf.sprintf "%s=0;" tab_sortie.(0))
	| Vdd -> produce_code (Printf.sprintf "%s=1;" tab_sortie.(0)) 
	| PipeNode (nom, line, _) ->  (Message.message#bloc_extern_for_compilation "bop2c" "unknown" line nom; failwith "w-friendly")
	| Regt -> ()
	| Regr index -> 
	    let s_index = Printf.sprintf "s_%d_0" index in
	    begin
	      if cds.(index).sortie.(0)
	      then Queue.add (s_index, "1") q_assign_init
	      else Queue.add (s_index, "0") q_assign_init;
	      Queue.add (Printf.sprintf "if(%s)%s=%s;" tab_entree.(1) s_index tab_entree.(0)) q_reg;
	    end 
	| _ -> ()
	    
        );
	aux (succ i)
      end
  in aux 0
(* ===================================================================== *)
;;

(* ===================================================================== *)
(** Soit on importe un fichier bpx resultant de la compilation d'une net
    list au format propretaire de bopsimu, soit d'une net-list bop
    directement. *)
type circuit_source = Bebop of string | Bebpx of string
(* ===================================================================== *)

(* ===================================================================== *)
(** Exeption levee quand la ligne de commande est incoherente *)
exception Arguments_Invalides
(* ===================================================================== *)

(* ===================================================================== *)
(** Deduire l'execution de Sys.argv le type d'execution *)
let execution_of_argv argv =
  let len = Array.length argv in
  let exists e =
    let rec aux i =
      if i >= len
      then false
      else if argv.(i) = e then true else aux (succ i)
    in aux 1
  in
  let first_filename =
    let rec aux i =
      if i >= len
      then None
      else 
	if argv.(i).[0] <> '-'
	then Some argv.(i)
	else aux (succ i)
    in aux 1
  in
  match first_filename with
  | None -> raise Arguments_Invalides
  | Some f -> 
      if exists "-x"
      then Bebpx f
      else Bebop f
(* ===================================================================== *)
;;

(* ===================================================================== *)
(** Aboutir aux donnees serialisables, soit en les lisant dans le bpx, 
    soit on les construisant depuis la netlist *)
(* ===================================================================== *)
let datas_of_exec = function
  | Bebop filename -> Cdsmaker.serialisation_of_net_list filename
  | Bebpx filename -> Cdsmaker.serialisation_of_bpx_file filename
(* ===================================================================== *)

(* ===================================================================== *)
(** la fonction pipe01 qui se charge du protocole de communication *)
(* ===================================================================== *)
let pipe01_en_C =
  "void pipe01(char *s, int num, FILE *fic)\n\
{\n\
\    int r = 0;\n\
\    unsigned char c = ' ';\n\
\n\
\    for( r=0; r<num; r++){\n\
\       c = fgetc(fic);\n\
\       if (c == '\\n'){\n\
\           fprintf(stderr, \"PROTOCOLE PIPE 01 ERROR\\n\");\n\
\           fprintf(stderr, \"arite donnee : %d, attendue : %d\\n\", r, num);\n\
\           fflush(stderr);\n\
\           exit(1);\n\
\       }\n\
\       s[r] = c;\n\
\     }\n\
\n\
\    while (c != '\\n'){\n\
\       c = fgetc(fic);\n\
\    }\n\
}";;
(* ===================================================================== *)

(* ===================================================================== *)
(** Ecrire le programme complet dans oc *)
(* ===================================================================== *)
let produce_Ccode (name, axiome, cds, roms, blocs_externes, e, s) oc =
  let produce s = (Printf.fprintf oc "%s" s; flush oc) in
  let vars, decl_init, assign_init, node, ram, reg, iimap =
    produce_code_of_cds_final cds in
  begin
    produce (Printf.sprintf "/* Programme C macro-généré par bop2c %s : %s */\n"
	       Message.version (Message.get_date ()));
    produce (Printf.sprintf "/* Circuit original : %s , Main = \"%s\"*/\n\n" name axiome);
    produce "#include <stdlib.h>\n";
    produce "#include <stdio.h>\n";
    produce "\n";
    produce pipe01_en_C;
    produce "\n";
    (* memoires ram *)
    Queue.iter (fun t -> produce t; produce "\n") ram;
    (* memoires rom *)
    let f_iteri i rom =
      let s = Ccode.of_rom i rom in
      produce s; produce "\n"
    in Array.iteri f_iteri roms;
    (* input_string, output_string *)
    Queue.iter (fun t -> produce t; produce "\n") decl_init;
    (* variables *)
    produce "\nunsigned char r";
    while not (Queue.is_empty vars) do
      let v = Queue.pop vars in
      produce (Printf.sprintf ", %s" v)
    done;
    produce ";\n\n";
    (* le main *)
    produce "int main(int argc, char **argv){\n";
    produce "    int ncy = 1, index_cy = 0;\n";
    produce "    if (argc>1) r = sscanf(argv[1], \"%d\", &ncy);\n";
    produce "\n";
    (* les assignations initiales *)
    produce "/* BEGIN assign init */\n";
    Queue.iter (fun (v, value) -> produce (Printf.sprintf "%s=%s;" v value)) assign_init;
    produce "\n/* END assign init */\n\n";
    (* boucle principale *)
    produce "    while(index_cy < ncy){\n";
    produce "/* BEGIN netlist */\n";
    (* les noeuds de la net list *)
    Queue.iter (fun t -> produce t; produce "\n") node;
    (* l'update register *)
    produce "\n";
    Queue.iter (fun t -> produce t; produce "\n") reg;
    produce "\n/* END netlist */\n";
    produce "        if(r)index_cy++;\n";
    produce "    }\n";
    produce "    return(0);\n";
    produce "}\n";
  end
(* ===================================================================== *)


let _ =
  Message.message#verbose_actif;
  Message.message#thisis "bop2c";
  try
    let e = execution_of_argv Sys.argv in
    let d = datas_of_exec e in
    Printf.fprintf stderr "TARGET = C\n";
    flush stderr;
    produce_Ccode d stdout
  with
  | Arguments_Invalides ->
      begin
	Printf.fprintf stderr "bop use : %s netlist.bop > result.c\nbpx use : %s -x netlist.bpx > result.c\n" Sys.argv.(0) Sys.argv.(0);
	flush stderr;
	exit 1
      end
